misc/legacy/sorted out 1.0.0 - 1.1.0/test-fscale-STD_old.R

In SebKrantz/collapse: Advanced and Fast Data Transformation

context("fscale / STD")

x <- rnorm(100)
w <- abs(100*rnorm(100))
wdat <- abs(100*rnorm(32))
xNA <- x
wNA <- w
wdatNA <- wdat
xNA[sample.int(100,20)] <- NA
wNA[sample.int(100,20)] <- NA
wdatNA[sample.int(32, 5)] <- NA
f <- as.factor(rep(1:10, each = 10))
g <- as.factor(rep(c(1,2,2,3,3,3,4,4,4,4,5,5,5,5,5,7,7,7,7,7,7,7,10,10,10,10,10,10,10,10,10,10)))
mtcNA <- na_insert(mtcars)
mtcNA[1,1] <- NA # single group NA !!
m <- as.matrix(mtcars)
mNA <- as.matrix(mtcNA)
mNAc <- mNA
storage.mode(mNAc) <- "character"

bscale <- function(x, na.rm = FALSE) if(na.rm || !anyNA(x)) `attributes<-`(drop(scale(x)), NULL) else rep(NA_real_, length(x))
# NOTE: This is what fscale currently does: If missing values, compute weighted mean and sd on available obs, and scale x using it. but don't insert aditional missing values in x for missing weights ..
wbscale <- function(x, w, na.rm = FALSE) {
  if(na.rm) {
    x2 <- x
    cc <- complete.cases(x, w)
    x <- x[cc]
    w <- w[cc]
  }
  sw <- sum(w)
  wm <- sum(w * x) / sw
  xdm <- x - wm
  wsd <- sqrt(sum(w * xdm^2) / (sw - 1))
  if(!na.rm) return(xdm / wsd)
  return((x2 - wm) / wsd)
}

# fscale by Welford's algoritm (default)

test_that("fscale performs like bscale", {
  expect_equal(fscale(NA), as.double(bscale(NA)))
  expect_equal(fscale(NA, na.rm = FALSE), as.double(bscale(NA)))
  expect_equal(fscale(1), bscale(1, na.rm = TRUE))
  expect_equal(fscale(1:3), bscale(1:3, na.rm = TRUE))
  expect_equal(fscale(-1:1), bscale(-1:1, na.rm = TRUE))
  expect_equal(fscale(1, na.rm = FALSE), bscale(1))
  expect_equal(fscale(1:3, na.rm = FALSE), bscale(1:3))
  expect_equal(fscale(-1:1, na.rm = FALSE), bscale(-1:1))
  expect_equal(fscale(x), bscale(x, na.rm = TRUE))
  expect_equal(fscale(x, na.rm = FALSE), bscale(x))
  expect_equal(fscale(xNA, na.rm = FALSE), bscale(xNA))
  expect_equal(fscale(xNA), bscale(xNA, na.rm = TRUE))
  expect_equal(qM(fscale(mtcars)), fscale(m))
  expect_equal(fscale(m), dapply(m, bscale, na.rm = TRUE))
  expect_equal(fscale(m, na.rm = FALSE), dapply(m, bscale))
  expect_equal(fscale(mNA, na.rm = FALSE), dapply(mNA, bscale))
  expect_equal(fscale(mNA), dapply(mNA, bscale, na.rm = TRUE))
  expect_equal(fscale(x, f), BY(x, f, bscale, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(fscale(x, f, na.rm = FALSE), BY(x, f, bscale, use.g.names = FALSE))
  expect_equal(fscale(xNA, f, na.rm = FALSE), BY(xNA, f, bscale, use.g.names = FALSE))
  expect_equal(fscale(xNA, f), BY(xNA, f, bscale, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(fscale(m, g), BY(m, g, bscale, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(fscale(m, g, na.rm = FALSE), BY(m, g, bscale, use.g.names = FALSE))
  expect_equal(fscale(mNA, g, na.rm = FALSE), BY(mNA, g, bscale, use.g.names = FALSE))
  expect_equal(fscale(mNA, g), BY(mNA, g, bscale, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(fscale(mtcars, g), BY(mtcars, g, bscale, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(fscale(mtcars, g, na.rm = FALSE), BY(mtcars, g, bscale, use.g.names = FALSE))
  expect_equal(fscale(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, bscale, use.g.names = FALSE))
  expect_equal(fscale(mtcNA, g), BY(mtcNA, g, bscale, na.rm = TRUE, use.g.names = FALSE))
})

test_that("fscale performs like fscale with unit weights", {
  expect_equal(fscale(NA), fscale(NA, w = 1))
  expect_equal(fscale(NA, na.rm = FALSE), fscale(NA, w = 1, na.rm = FALSE))
  expect_equal(fscale(1), fscale(1, w = 1))
  expect_equal(fscale(1:3), fscale(1:3, w = rep(1,3)))
  expect_equal(fscale(-1:1), fscale(-1:1, w = rep(1,3)))
  expect_equal(fscale(1, na.rm = FALSE), fscale(1, w = 1, na.rm = FALSE))
  expect_equal(fscale(1:3, na.rm = FALSE), fscale(1:3, w = rep(1, 3), na.rm = FALSE))
  expect_equal(fscale(-1:1, na.rm = FALSE), fscale(-1:1, w = rep(1, 3), na.rm = FALSE))
  expect_equal(fscale(x), fscale(x, w = rep(1,100)))
  expect_equal(fscale(x, na.rm = FALSE), fscale(x, w = rep(1, 100), na.rm = FALSE))
  expect_equal(fscale(xNA, na.rm = FALSE), fscale(xNA, w = rep(1, 100), na.rm = FALSE))
  expect_equal(fscale(xNA), fscale(xNA, w = rep(1, 100)))
  expect_equal(fscale(m), fscale(m, w = rep(1, 32)))
  expect_equal(fscale(m, na.rm = FALSE), fscale(m, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale(mNA, na.rm = FALSE), fscale(mNA, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale(mNA), fscale(mNA, w = rep(1, 32)))
  expect_equal(fscale(mtcars), fscale(mtcars, w = rep(1, 32)))
  expect_equal(fscale(mtcars, na.rm = FALSE), fscale(mtcars, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale(mtcNA, na.rm = FALSE), fscale(mtcNA, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale(mtcNA), fscale(mtcNA, w = rep(1, 32)))
  expect_equal(fscale(x, f), fscale(x, f, rep(1,100)))
  expect_equal(fscale(x, f, na.rm = FALSE), fscale(x, f, rep(1,100), na.rm = FALSE))
  expect_equal(fscale(xNA, f, na.rm = FALSE), fscale(xNA, f, rep(1,100), na.rm = FALSE))
  expect_equal(fscale(xNA, f), fscale(xNA, f, rep(1,100)))
  expect_equal(fscale(m, g), fscale(m, g, rep(1,32)))
  expect_equal(fscale(m, g, na.rm = FALSE), fscale(m, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale(mNA, g, na.rm = FALSE), fscale(mNA, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale(mNA, g), fscale(mNA, g, rep(1,32)))
  expect_equal(fscale(mtcars, g), fscale(mtcars, g, rep(1,32)))
  expect_equal(fscale(mtcars, g, na.rm = FALSE), fscale(mtcars, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale(mtcNA, g, na.rm = FALSE), fscale(mtcNA, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale(mtcNA, g), fscale(mtcNA, g, rep(1,32)))
})

test_that("fscale with weights performs like wbscale (defined above)", {
  # complete weights
  expect_equal(fscale(NA, w = 1), wbscale(NA, 1))
  expect_equal(fscale(NA, w = 1, na.rm = FALSE), wbscale(NA, 1))
  expect_equal(fscale(1, w = 1), wbscale(1, w = 1))
  expect_equal(fscale(1:3, w = 1:3), wbscale(1:3, 1:3))
  expect_equal(fscale(-1:1, w = 1:3), wbscale(-1:1, 1:3))
  expect_equal(fscale(1, w = 1, na.rm = FALSE), wbscale(1, 1))
  expect_equal(fscale(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wbscale(1:3, c(0.99,3454,1.111)))
  expect_equal(fscale(-1:1, w = 1:3, na.rm = FALSE), wbscale(-1:1, 1:3))
  expect_equal(fscale(x, w = w), wbscale(x, w))
  expect_equal(fscale(x, w = w, na.rm = FALSE), wbscale(x, w))
  expect_equal(fscale(xNA, w = w, na.rm = FALSE), wbscale(xNA, w))
  expect_equal(fscale(xNA, w = w), wbscale(xNA, w, na.rm = TRUE))
  expect_equal(qM(fscale(mtcars, w = wdat)), fscale(m, w = wdat))
  expect_equal(fscale(m, w = wdat), dapply(m, wbscale, wdat, na.rm = TRUE))
  expect_equal(fscale(m, w = wdat, na.rm = FALSE), dapply(m, wbscale, wdat))
  expect_equal(fscale(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wbscale, wdat))
  expect_equal(fscale(mNA, w = wdat), dapply(mNA, wbscale, wdat, na.rm = TRUE))
  expect_equal(fscale(x, f, w), unlist(Map(wbscale, split(x, f), split(w, f)), use.names = FALSE))
  expect_equal(fscale(x, f, w, na.rm = FALSE), unlist(Map(wbscale, split(x, f), split(w, f)), use.names = FALSE))
  expect_equal(fscale(xNA, f, w, na.rm = FALSE), unlist(Map(wbscale, split(xNA, f), split(w, f)), use.names = FALSE))
  expect_equal(fscale(xNA, f, w), unlist(Map(wbscale, split(xNA, f), split(w, f), na.rm = TRUE), use.names = FALSE))
  # missing weights
  expect_equal(fscale(NA, w = NA), wbscale(NA, NA))
  expect_equal(fscale(NA, w = NA, na.rm = FALSE), wbscale(NA, NA))
  expect_equal(fscale(1, w = NA), wbscale(1, w = NA))
  expect_equal(fscale(1:3, w = c(NA,1:2)), wbscale(1:3, c(NA,1:2), na.rm = TRUE))
  expect_equal(fscale(-1:1, w = c(NA,1:2)), wbscale(-1:1, c(NA,1:2), na.rm = TRUE))
  expect_equal(fscale(1, w = NA, na.rm = FALSE), wbscale(1, NA))
  expect_equal(fscale(1:3, w = c(NA,1:2), na.rm = FALSE), wbscale(1:3, c(NA,1:2)))
  expect_equal(fscale(-1:1, w = c(NA,1:2), na.rm = FALSE), wbscale(-1:1, c(NA,1:2)))
  expect_equal(fscale(x, w = wNA), wbscale(x, wNA, na.rm = TRUE))
  expect_equal(fscale(x, w = wNA, na.rm = FALSE), wbscale(x, wNA))
  expect_equal(fscale(xNA, w = wNA, na.rm = FALSE), wbscale(xNA, wNA))
  expect_equal(fscale(xNA, w = wNA), wbscale(xNA, wNA, na.rm = TRUE))
  expect_equal(qM(fscale(mtcars, w = wdatNA)), fscale(m, w = wdatNA))
  expect_equal(fscale(m, w = wdatNA), dapply(m, wbscale, wdatNA, na.rm = TRUE))
  expect_equal(fscale(m, w = wdatNA, na.rm = FALSE), dapply(m, wbscale, wdatNA))
  expect_equal(fscale(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wbscale, wdatNA))
  expect_equal(fscale(mNA, w = wdatNA), dapply(mNA, wbscale, wdatNA, na.rm = TRUE))
  expect_equal(fscale(x, f, wNA), unlist(Map(wbscale, split(x, f), split(wNA, f), na.rm = TRUE), use.names = FALSE))
  expect_equal(fscale(x, f, wNA, na.rm = FALSE), unlist(Map(wbscale, split(x, f), split(wNA, f)), use.names = FALSE))
  expect_equal(fscale(xNA, f, wNA, na.rm = FALSE), unlist(Map(wbscale, split(xNA, f), split(wNA, f)), use.names = FALSE))
  expect_equal(fscale(xNA, f, wNA), unlist(Map(wbscale, split(xNA, f), split(wNA, f), na.rm = TRUE), use.names = FALSE))
})

test_that("fscale performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fscale(1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(NA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, g), simplify = FALSE)))
})

test_that("fscale with complete weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fscale(1, w = 1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(NA, w = 1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, g, wdat), simplify = FALSE)))
})

test_that("fscale with missing weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fscale(1, w = NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(NA, w = NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(xNA, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mNA, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale(mtcNA, g, wdatNA), simplify = FALSE)))
})

# NOTE: fscale(c(a, a)) gives c(NaN, NaN) (sd is 0) !!!
test_that("fscale handles special values in the right way", {
  expect_equal(fscale(NA), NA_real_)
  expect_equal(fscale(NaN), NA_real_)
  expect_equal(fscale(Inf), NA_real_)
  expect_equal(fscale(-Inf), NA_real_)
  expect_equal(fscale(TRUE), NA_real_)
  expect_equal(fscale(FALSE), NA_real_)
  expect_equal(fscale(NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(NaN, na.rm = FALSE), NA_real_)
  expect_equal(fscale(Inf, na.rm = FALSE), NA_real_)
  expect_equal(fscale(-Inf, na.rm = FALSE), NA_real_)
  expect_equal(fscale(TRUE, na.rm = FALSE), NA_real_)
  expect_equal(fscale(FALSE, na.rm = FALSE), NA_real_)
  expect_equal(fscale(c(1,NA)), c(NA_real_,NA_real_))
  expect_equal(fscale(c(1,NaN)), c(NA_real_,NA_real_))
  expect_equal(fscale(c(1,Inf)), c(NA_real_,NA_real_))
  expect_equal(fscale(c(1,-Inf)), c(NA_real_,NA_real_))
  expect_equal(fscale(c(1,Inf), na.rm = FALSE), c(NA_real_,NA_real_))
  expect_equal(fscale(c(1,-Inf), na.rm = FALSE), c(NA_real_,NA_real_))
  expect_equal(fscale(c(FALSE,FALSE), na.rm = FALSE), c(NaN,NaN))
  expect_equal(fscale(c(1,1), na.rm = FALSE), c(NaN,NaN))
})

test_that("fscale with weights handles special values in the right way", {
  expect_equal(fscale(NA, w = 1), NA_real_)
  expect_equal(fscale(NaN, w = 1), NA_real_)
  expect_equal(fscale(Inf, w = 1), NA_real_)
  expect_equal(fscale(-Inf, w = 1), NA_real_)
  expect_equal(fscale(TRUE, w = 1), NA_real_)
  expect_equal(fscale(FALSE, w = 1), NA_real_)
  expect_equal(fscale(NA, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale(NaN, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale(Inf, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale(-Inf, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale(TRUE, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale(FALSE, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale(NA, w = NA), NA_real_)
  expect_equal(fscale(NaN, w = NA), NA_real_)
  expect_equal(fscale(Inf, w = NA), NA_real_)
  expect_equal(fscale(-Inf, w = NA), NA_real_)
  expect_equal(fscale(TRUE, w = NA), NA_real_)
  expect_equal(fscale(FALSE, w = NA), NA_real_)
  expect_equal(fscale(NA, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(NaN, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(Inf, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(-Inf, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(TRUE, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(FALSE, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale(1:3, w = c(1,Inf,3)), c(NA_real_,NA_real_,NA_real_))
  expect_equal(fscale(1:3, w = c(1,-Inf,3)), c(NA_real_,NA_real_,NA_real_))
  expect_equal(fscale(1:3, w = c(1,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
  expect_equal(fscale(1:3, w = c(1,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
})

test_that("fscale produces errors for wrong input", {
  expect_error(fscale("a"))
  expect_error(fscale(NA_character_))
  expect_error(fscale(mNAc))
  expect_error(fscale(mNAc, f))
  expect_error(fscale(1:2,1:3))
  expect_error(fscale(m,1:31))
  expect_error(fscale(mtcars,1:31))
  expect_error(fscale("a", w = 1))
  expect_error(fscale(1:2, w = 1:3))
  expect_error(fscale(NA_character_, w = 1))
  expect_error(fscale(mNAc, w = wdat))
  expect_error(fscale(mNAc, f, wdat))
  expect_error(fscale(mNA, w = 1:33))
  expect_error(fscale(1:2,1:2, 1:3))
  expect_error(fscale(m,1:32,1:20))
  expect_error(fscale(mtcars,1:32,1:10))
  expect_error(fscale(1:2, w = c("a","b")))
  expect_error(fscale(wlddev))
  expect_error(fscale(wlddev, w = wlddev$year))
  expect_error(fscale(wlddev, wlddev$iso3c))
  expect_error(fscale(wlddev, wlddev$iso3c, wlddev$year))
})


# Repeating all tests for the other algorithm

fscale2a <- function(x, ...) fscale(x, ..., stable.algo = FALSE)

test_that("fscale2a performs like bscale", {
  expect_equal(fscale2a(NA), as.double(bscale(NA)))
  expect_equal(fscale2a(NA, na.rm = FALSE), as.double(bscale(NA)))
  expect_equal(fscale2a(1), bscale(1, na.rm = TRUE))
  expect_equal(fscale2a(1:3), bscale(1:3, na.rm = TRUE))
  expect_equal(fscale2a(-1:1), bscale(-1:1, na.rm = TRUE))
  expect_equal(fscale2a(1, na.rm = FALSE), bscale(1))
  expect_equal(fscale2a(1:3, na.rm = FALSE), bscale(1:3))
  expect_equal(fscale2a(-1:1, na.rm = FALSE), bscale(-1:1))
  expect_equal(fscale2a(x), bscale(x, na.rm = TRUE))
  expect_equal(fscale2a(x, na.rm = FALSE), bscale(x))
  expect_equal(fscale2a(xNA, na.rm = FALSE), bscale(xNA))
  expect_equal(fscale2a(xNA), bscale(xNA, na.rm = TRUE))
  expect_equal(qM(fscale2a(mtcars)), fscale2a(m))
  expect_equal(fscale2a(m), dapply(m, bscale, na.rm = TRUE))
  expect_equal(fscale2a(m, na.rm = FALSE), dapply(m, bscale))
  expect_equal(fscale2a(mNA, na.rm = FALSE), dapply(mNA, bscale))
  expect_equal(fscale2a(mNA), dapply(mNA, bscale, na.rm = TRUE))
  expect_equal(fscale2a(x, f), BY(x, f, bscale, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(fscale2a(x, f, na.rm = FALSE), BY(x, f, bscale, use.g.names = FALSE))
  expect_equal(fscale2a(xNA, f, na.rm = FALSE), BY(xNA, f, bscale, use.g.names = FALSE))
  expect_equal(fscale2a(xNA, f), BY(xNA, f, bscale, na.rm = TRUE, use.g.names = FALSE))
  # expect_equal(fscale2a(m, g), BY(m, g, bscale, na.rm = TRUE, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(m, g, na.rm = FALSE), BY(m, g, bscale, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(mNA, g, na.rm = FALSE), BY(mNA, g, bscale, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(mNA, g), BY(mNA, g, bscale, na.rm = TRUE, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(mtcars, g), BY(mtcars, g, bscale, na.rm = TRUE, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(mtcars, g, na.rm = FALSE), BY(mtcars, g, bscale, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, bscale, use.g.names = FALSE)) # failed on arch i386 CMD check
  # expect_equal(fscale2a(mtcNA, g), BY(mtcNA, g, bscale, na.rm = TRUE, use.g.names = FALSE)) # failed on arch i386 CMD check
})

test_that("fscale2a performs like fscale2a with unit weights", {
  expect_equal(fscale2a(NA), fscale2a(NA, w = 1))
  expect_equal(fscale2a(NA, na.rm = FALSE), fscale2a(NA, w = 1, na.rm = FALSE))
  expect_equal(fscale2a(1), fscale2a(1, w = 1))
  expect_equal(fscale2a(1:3), fscale2a(1:3, w = rep(1,3)))
  expect_equal(fscale2a(-1:1), fscale2a(-1:1, w = rep(1,3)))
  expect_equal(fscale2a(1, na.rm = FALSE), fscale2a(1, w = 1, na.rm = FALSE))
  expect_equal(fscale2a(1:3, na.rm = FALSE), fscale2a(1:3, w = rep(1, 3), na.rm = FALSE))
  expect_equal(fscale2a(-1:1, na.rm = FALSE), fscale2a(-1:1, w = rep(1, 3), na.rm = FALSE))
  expect_equal(fscale2a(x), fscale2a(x, w = rep(1,100)))
  expect_equal(fscale2a(x, na.rm = FALSE), fscale2a(x, w = rep(1, 100), na.rm = FALSE))
  expect_equal(fscale2a(xNA, na.rm = FALSE), fscale2a(xNA, w = rep(1, 100), na.rm = FALSE))
  expect_equal(fscale2a(xNA), fscale2a(xNA, w = rep(1, 100)))
  expect_equal(fscale2a(m), fscale2a(m, w = rep(1, 32)))
  expect_equal(fscale2a(m, na.rm = FALSE), fscale2a(m, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale2a(mNA, na.rm = FALSE), fscale2a(mNA, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale2a(mNA), fscale2a(mNA, w = rep(1, 32)))
  expect_equal(fscale2a(mtcars), fscale2a(mtcars, w = rep(1, 32)))
  expect_equal(fscale2a(mtcars, na.rm = FALSE), fscale2a(mtcars, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale2a(mtcNA, na.rm = FALSE), fscale2a(mtcNA, w = rep(1, 32), na.rm = FALSE))
  expect_equal(fscale2a(mtcNA), fscale2a(mtcNA, w = rep(1, 32)))
  expect_equal(fscale2a(x, f), fscale2a(x, f, rep(1,100)))
  expect_equal(fscale2a(x, f, na.rm = FALSE), fscale2a(x, f, rep(1,100), na.rm = FALSE))
  expect_equal(fscale2a(xNA, f, na.rm = FALSE), fscale2a(xNA, f, rep(1,100), na.rm = FALSE))
  expect_equal(fscale2a(xNA, f), fscale2a(xNA, f, rep(1,100)))
  expect_equal(fscale2a(m, g), fscale2a(m, g, rep(1,32)))
  expect_equal(fscale2a(m, g, na.rm = FALSE), fscale2a(m, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale2a(mNA, g, na.rm = FALSE), fscale2a(mNA, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale2a(mNA, g), fscale2a(mNA, g, rep(1,32)))
  expect_equal(fscale2a(mtcars, g), fscale2a(mtcars, g, rep(1,32)))
  expect_equal(fscale2a(mtcars, g, na.rm = FALSE), fscale2a(mtcars, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale2a(mtcNA, g, na.rm = FALSE), fscale2a(mtcNA, g, rep(1,32), na.rm = FALSE))
  expect_equal(fscale2a(mtcNA, g), fscale2a(mtcNA, g, rep(1,32)))
})

test_that("fscale2a with weights performs like wbscale (defined above)", {
  # complete weights
  expect_equal(fscale2a(NA, w = 1), wbscale(NA, 1))
  expect_equal(fscale2a(NA, w = 1, na.rm = FALSE), wbscale(NA, 1))
  expect_equal(fscale2a(1, w = 1), wbscale(1, w = 1))
  expect_equal(fscale2a(1:3, w = 1:3), wbscale(1:3, 1:3))
  expect_equal(fscale2a(-1:1, w = 1:3), wbscale(-1:1, 1:3))
  expect_equal(fscale2a(1, w = 1, na.rm = FALSE), wbscale(1, 1))
  expect_equal(fscale2a(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wbscale(1:3, c(0.99,3454,1.111)))
  expect_equal(fscale2a(-1:1, w = 1:3, na.rm = FALSE), wbscale(-1:1, 1:3))
  expect_equal(fscale2a(x, w = w), wbscale(x, w))
  expect_equal(fscale2a(x, w = w, na.rm = FALSE), wbscale(x, w))
  expect_equal(fscale2a(xNA, w = w, na.rm = FALSE), wbscale(xNA, w))
  expect_equal(fscale2a(xNA, w = w), wbscale(xNA, w, na.rm = TRUE))
  expect_equal(qM(fscale2a(mtcars, w = wdat)), fscale2a(m, w = wdat))
  expect_equal(fscale2a(m, w = wdat), dapply(m, wbscale, wdat, na.rm = TRUE))
  expect_equal(fscale2a(m, w = wdat, na.rm = FALSE), dapply(m, wbscale, wdat))
  expect_equal(fscale2a(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wbscale, wdat))
  expect_equal(fscale2a(mNA, w = wdat), dapply(mNA, wbscale, wdat, na.rm = TRUE))
  expect_equal(fscale2a(x, f, w), unlist(Map(wbscale, split(x, f), split(w, f)), use.names = FALSE))
  expect_equal(fscale2a(x, f, w, na.rm = FALSE), unlist(Map(wbscale, split(x, f), split(w, f)), use.names = FALSE))
  expect_equal(fscale2a(xNA, f, w, na.rm = FALSE), unlist(Map(wbscale, split(xNA, f), split(w, f)), use.names = FALSE))
  expect_equal(fscale2a(xNA, f, w), unlist(Map(wbscale, split(xNA, f), split(w, f), na.rm = TRUE), use.names = FALSE))
  # missing weights
  expect_equal(fscale2a(NA, w = NA), wbscale(NA, NA))
  expect_equal(fscale2a(NA, w = NA, na.rm = FALSE), wbscale(NA, NA))
  expect_equal(fscale2a(1, w = NA), wbscale(1, w = NA))
  expect_equal(fscale2a(1:3, w = c(NA,1:2)), wbscale(1:3, c(NA,1:2), na.rm = TRUE))
  expect_equal(fscale2a(-1:1, w = c(NA,1:2)), wbscale(-1:1, c(NA,1:2), na.rm = TRUE))
  expect_equal(fscale2a(1, w = NA, na.rm = FALSE), wbscale(1, NA))
  expect_equal(fscale2a(1:3, w = c(NA,1:2), na.rm = FALSE), wbscale(1:3, c(NA,1:2)))
  expect_equal(fscale2a(-1:1, w = c(NA,1:2), na.rm = FALSE), wbscale(-1:1, c(NA,1:2)))
  expect_equal(fscale2a(x, w = wNA), wbscale(x, wNA, na.rm = TRUE))
  expect_equal(fscale2a(x, w = wNA, na.rm = FALSE), wbscale(x, wNA))
  expect_equal(fscale2a(xNA, w = wNA, na.rm = FALSE), wbscale(xNA, wNA))
  expect_equal(fscale2a(xNA, w = wNA), wbscale(xNA, wNA, na.rm = TRUE))
  expect_equal(qM(fscale2a(mtcars, w = wdatNA)), fscale2a(m, w = wdatNA))
  expect_equal(fscale2a(m, w = wdatNA), dapply(m, wbscale, wdatNA, na.rm = TRUE))
  expect_equal(fscale2a(m, w = wdatNA, na.rm = FALSE), dapply(m, wbscale, wdatNA))
  expect_equal(fscale2a(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wbscale, wdatNA))
  expect_equal(fscale2a(mNA, w = wdatNA), dapply(mNA, wbscale, wdatNA, na.rm = TRUE))
  expect_equal(fscale2a(x, f, wNA), unlist(Map(wbscale, split(x, f), split(wNA, f), na.rm = TRUE), use.names = FALSE))
  expect_equal(fscale2a(x, f, wNA, na.rm = FALSE), unlist(Map(wbscale, split(x, f), split(wNA, f)), use.names = FALSE))
  expect_equal(fscale2a(xNA, f, wNA, na.rm = FALSE), unlist(Map(wbscale, split(xNA, f), split(wNA, f)), use.names = FALSE))
  expect_equal(fscale2a(xNA, f, wNA), unlist(Map(wbscale, split(xNA, f), split(wNA, f), na.rm = TRUE), use.names = FALSE))
})

test_that("fscale2a performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fscale2a(1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(NA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, g), simplify = FALSE)))
})

test_that("fscale2a with complete weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fscale2a(1, w = 1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(NA, w = 1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, g, wdat), simplify = FALSE)))
})

test_that("fscale2a with missing weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fscale2a(1, w = NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(NA, w = NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(xNA, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mNA, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fscale2a(mtcNA, g, wdatNA), simplify = FALSE))) # on some runs it fails..
})

# NOTE: fscale2a(c(a, a)) gives c(NaN, NaN) (sd is 0) !!!
test_that("fscale2a handles special values in the right way", {
  expect_equal(fscale2a(NA), NA_real_)
  expect_equal(fscale2a(NaN), NA_real_)
  expect_equal(fscale2a(Inf), NA_real_)
  expect_equal(fscale2a(-Inf), NA_real_)
  expect_equal(fscale2a(TRUE), NA_real_)
  expect_equal(fscale2a(FALSE), NA_real_)
  expect_equal(fscale2a(NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(NaN, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(Inf, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(-Inf, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(TRUE, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(FALSE, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(c(1,NA)), c(NA_real_,NA_real_))
  expect_equal(fscale2a(c(1,NaN)), c(NA_real_,NA_real_))
  expect_equal(fscale2a(c(1,Inf)), c(NA_real_,NA_real_))
  expect_equal(fscale2a(c(1,-Inf)), c(NA_real_,NA_real_))
  expect_equal(fscale2a(c(1,Inf), na.rm = FALSE), c(NA_real_,NA_real_))
  expect_equal(fscale2a(c(1,-Inf), na.rm = FALSE), c(NA_real_,NA_real_))
  expect_equal(fscale2a(c(FALSE,FALSE), na.rm = FALSE), c(NaN,NaN))
  expect_equal(fscale2a(c(1,1), na.rm = FALSE), c(NaN,NaN))
})

test_that("fscale2a with weights handles special values in the right way", {
  expect_equal(fscale2a(NA, w = 1), NA_real_)
  expect_equal(fscale2a(NaN, w = 1), NA_real_)
  expect_equal(fscale2a(Inf, w = 1), NA_real_)
  expect_equal(fscale2a(-Inf, w = 1), NA_real_)
  expect_equal(fscale2a(TRUE, w = 1), NA_real_)
  expect_equal(fscale2a(FALSE, w = 1), NA_real_)
  expect_equal(fscale2a(NA, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(NaN, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(Inf, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(-Inf, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(TRUE, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(FALSE, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(NA, w = NA), NA_real_)
  expect_equal(fscale2a(NaN, w = NA), NA_real_)
  expect_equal(fscale2a(Inf, w = NA), NA_real_)
  expect_equal(fscale2a(-Inf, w = NA), NA_real_)
  expect_equal(fscale2a(TRUE, w = NA), NA_real_)
  expect_equal(fscale2a(FALSE, w = NA), NA_real_)
  expect_equal(fscale2a(NA, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(NaN, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(Inf, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(-Inf, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(TRUE, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(FALSE, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fscale2a(1:3, w = c(1,Inf,3)), c(NA_real_,NA_real_,NA_real_))
  expect_equal(fscale2a(1:3, w = c(1,-Inf,3)), c(NA_real_,NA_real_,NA_real_))
  expect_equal(fscale2a(1:3, w = c(1,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
  expect_equal(fscale2a(1:3, w = c(1,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
})

test_that("fscale2a produces errors for wrong input", {
  expect_error(fscale2a("a"))
  expect_error(fscale2a(NA_character_))
  expect_error(fscale2a(mNAc))
  expect_error(fscale2a(mNAc, f))
  expect_error(fscale2a(1:2,1:3))
  expect_error(fscale2a(m,1:31))
  expect_error(fscale2a(mtcars,1:31))
  expect_error(fscale2a("a", w = 1))
  expect_error(fscale2a(1:2, w = 1:3))
  expect_error(fscale2a(NA_character_, w = 1))
  expect_error(fscale2a(mNAc, w = wdat))
  expect_error(fscale2a(mNAc, f, wdat))
  expect_error(fscale2a(mNA, w = 1:33))
  expect_error(fscale2a(1:2,1:2, 1:3))
  expect_error(fscale2a(m,1:32,1:20))
  expect_error(fscale2a(mtcars,1:32,1:10))
  expect_error(fscale2a(1:2, w = c("a","b")))
  expect_error(fscale2a(wlddev))
  expect_error(fscale2a(wlddev, w = wlddev$year))
  expect_error(fscale2a(wlddev, wlddev$iso3c))
  expect_error(fscale2a(wlddev, wlddev$iso3c, wlddev$year))
})


# Testing STD: Only testing wrong inputs, especially for data.frame method. Otherwise it is identical to fscale

test_that("STD produces errors for wrong input", {
  expect_error(STD("a"))
  expect_error(STD(NA_character_))
  expect_error(STD(mNAc))
  expect_error(STD(mNAc, f))
  expect_error(STD(1:2,1:3))
  expect_error(STD(m,1:31))
  expect_error(STD(mtcars,1:31))
  expect_error(STD("a", w = 1))
  expect_error(STD(1:2, w = c("a","b")))
  expect_error(STD(1:2, w = 1:3))
  expect_error(STD(NA_character_, w = 1))
  expect_error(STD(mNAc, w = wdat))
  expect_error(STD(mNAc, f, wdat))
  expect_error(STD(mNA, w = 1:33))
  expect_error(STD(mtcNA, w = 1:33))
  expect_error(STD(1:2,1:2, 1:3))
  expect_error(STD(m,1:32,1:20))
  expect_error(STD(mtcars,1:32,1:10))
  expect_error(STD(1:2, 1:3, 1:2))
  expect_error(STD(m,1:31,1:32))
  expect_error(STD(mtcars,1:33,1:32))
})

test_that("STD.data.frame method is foolproof", {
  expect_visible(STD(wlddev))
  expect_visible(STD(wlddev, w = wlddev$year))
  expect_visible(STD(wlddev, w = ~year))
  expect_visible(STD(wlddev, wlddev$iso3c))
  expect_visible(STD(wlddev, ~iso3c))
  expect_visible(STD(wlddev, ~iso3c + region))
  expect_visible(STD(wlddev, wlddev$iso3c, wlddev$year))
  expect_visible(STD(wlddev, ~iso3c, ~year))
  expect_visible(STD(wlddev, cols = 9:12))
  expect_visible(STD(wlddev, w = wlddev$year, cols = 9:12))
  expect_visible(STD(wlddev, w = ~year, cols = 9:12))
  expect_visible(STD(wlddev, wlddev$iso3c, cols = 9:12))
  expect_visible(STD(wlddev, ~iso3c, cols = 9:12))
  expect_visible(STD(wlddev, wlddev$iso3c, wlddev$year, cols = 9:12))
  expect_visible(STD(wlddev, ~iso3c, ~year, cols = 9:12))
  expect_visible(STD(wlddev, cols = c("PCGDP","LIFEEX")))
  expect_visible(STD(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX")))
  expect_visible(STD(wlddev, w = ~year, cols = c("PCGDP","LIFEEX")))
  expect_visible(STD(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX")))
  expect_visible(STD(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX")))
  expect_visible(STD(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX")))
  expect_visible(STD(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX")))

  expect_error(STD(wlddev, cols = NULL))
  expect_error(STD(wlddev, w = wlddev$year, cols = NULL))
  expect_error(STD(wlddev, w = ~year, cols = NULL))
  expect_error(STD(wlddev, wlddev$iso3c, cols = NULL))
  expect_error(STD(wlddev, ~iso3c, cols = NULL))
  expect_error(STD(wlddev, wlddev$iso3c, wlddev$year, cols = NULL))
  expect_error(STD(wlddev, ~iso3c, ~year, cols = NULL))
  expect_error(STD(wlddev, cols = 9:13))
  expect_error(STD(wlddev, w = wlddev$year, cols = 9:13))
  expect_error(STD(wlddev, w = ~year, cols = 9:13))
  expect_error(STD(wlddev, wlddev$iso3c, cols = 9:13))
  expect_error(STD(wlddev, ~iso3c, cols = 9:13))
  expect_error(STD(wlddev, wlddev$iso3c, wlddev$year, cols = 9:13))
  expect_error(STD(wlddev, ~iso3c, ~year, cols = 9:13))
  expect_error(STD(wlddev, cols = c("PCGDP","LIFEEX","bla")))
  expect_error(STD(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
  expect_error(STD(wlddev, w = ~year, cols = c("PCGDP","LIFEEX","bla")))
  expect_error(STD(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX","bla")))
  expect_error(STD(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX","bla")))
  expect_error(STD(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
  expect_error(STD(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX","bla")))

  expect_error(STD(wlddev, w = mtcars))
  expect_error(STD(wlddev, w = 4))
  expect_error(STD(wlddev, w = "year"))
  expect_error(STD(wlddev, w = ~year2))
  expect_error(STD(wlddev, w = ~year + region))
  expect_error(STD(wlddev, mtcars))
  expect_error(STD(wlddev, 2))
  expect_error(STD(wlddev, "iso3c"))
  expect_error(STD(wlddev, ~iso3c2))
  expect_error(STD(wlddev, ~iso3c + bla))
  expect_error(STD(wlddev, mtcars$mpg, mtcars$cyl))
  expect_error(STD(wlddev, 2, 4))
  expect_error(STD(wlddev, ~iso3c2, ~year2))
  expect_error(STD(wlddev, cols = ~bla))
  expect_error(STD(wlddev, w = ~bla, cols = 9:12))
  expect_error(STD(wlddev, w = 4, cols = 9:12))
  expect_error(STD(wlddev, w = "year", cols = 9:12))
  expect_error(STD(wlddev, w = ~yewar, cols = 9:12))
  expect_error(STD(wlddev, mtcars$mpg, cols = 9:12))
  expect_error(STD(wlddev, ~iso3c + ss, cols = 9:12))
  expect_error(STD(wlddev, 2, cols = 9:12))
  expect_error(STD(wlddev, "iso3c", cols = 9:12))
  expect_error(STD(wlddev, wlddev$iso3c, ~year + bla, cols = 9:12))
  expect_error(STD(wlddev, ~iso3c3, ~year, cols = 9:12))
  expect_error(STD(wlddev, cols = c("PC3GDP","LIFEEX")))
})